home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
GOFER
/
!GToC
/
h
/
gofc
next >
Wrap
Text File
|
1993-02-17
|
12KB
|
285 lines
/* --------------------------------------------------------------------------
* gofc.h: Copyright (c) Mark P Jones 1991-1993. All rights reserved.
* See goferite.h for details and conditions of use etc...
* Gofer Compiler version 1.00 February 1992
* Gofer version 2.28 January 1993
*
* Header file for Gofer Compiler runtime system.
* ------------------------------------------------------------------------*/
#include "prelude.h"
/*- Garbage collected heap ------------------------------------------------*/
#define GC_MARKSCAN 0 /* for mark/scan collector */
#define GC_TWOSPACE 1 /* for twospace collector */
typedef Int Cell; /* general cell value */
typedef Cell far *Heap; /* storage of heap */
extern Int heapSize; /* Pairs are stored in the */
extern Void garbageCollect Args((Void));
#if GC_MARKSCAN
#ifdef GLOBALcar
register Heap heapTopCar GLOBALcar; /* Cells with -ve indices */
#else
extern Heap heapTopCar;
#endif
#ifdef GLOBALcdr
register Heap heapTopCdr GLOBALcdr;
#else
extern Heap heapTopCdr;
#endif
#define fst(c) heapTopCar[c]
#define snd(c) heapTopCdr[c]
#define isPair(c) ((c)<0)
extern Cell pair Args((Cell,Cell));
#endif
#if GC_TWOSPACE
#ifdef GLOBALcar
register Heap from GLOBALcar;
#else
extern Heap from; /* top of from space */
#endif
#ifdef GLOBALcdr
register Cell hp GLOBALcdr;
#else
extern Cell hp; /* last used heap loc */
#endif
#define fst(c) from[c]
#define snd(c) from[(c)+1]
#define isPair(c) ((c)<0)
#define INLINE_ALLOC 0 /* 1 => allocate inline */
#if INLINE_ALLOC
#define pair(l,r) ((from[++hp]=(l)), (from[++hp]=(r)), (hp-1))
#else
extern Cell pair Args((Cell,Cell));
#endif
#endif
/*- Tags for fst() element in particular kinds of Pair ------------------- */
#define INDIRECT 0 /* Indirection */
#define INDIRECT1 1 /* Second form used in gc */
#define FORWARD 2 /* Forwarding pointer */
#define INTCELL 3 /* (Big) Integer */
#define STRCELL 4 /* Character String */
#define SUPERCOMB 5 /* Supercombinator */
#define FILECELL 6 /* File value */
#define FLOATCELL 7 /* Floating point */
#if BREAK_FLOATS
#define MAXBOXTAG FILECELL /* Last boxed cell tag */
extern Cell safeMkFloat Args((FloatPro));
#else
#define MAXBOXTAG FLOATCELL /* Last boxed cell tag */
#define safeMkFloat(n) mkFloat(n)
#endif
#define MAXTAG FLOATCELL /* Last tag value */
#define mkBig(n) pair(INTCELL,n)
#define bigOf(c) ((Int)(snd(c)))
typedef FloatImpType Float;
extern Cell mkFloat Args((FloatPro));
extern FloatPro floatOf Args((Cell));
extern String floatToString Args((FloatPro));
extern FloatPro stringToFloat Args((String));
#define mkString(s) pair(STRCELL,(Int)(s))
#define stringOf(c) ((String)(snd(c)))
#define mkSuper(sc) pair(SUPERCOMB,(Int)(sc))
#define superOf(c) ((Super *)(snd(c)))
/*- Cells>MAXTAG represent small integers, characters, dictionaries and -- */
/*- constructor functions -- we don't have to worry which since these ---- */
/*- routines will only be used with well-typed source programs ----------- */
#define SMALLMIN (MAXTAG+2)
#define SMALLMAX MAXPOSINT
#define SMALLZERO (SMALLMIN/2 + SMALLMAX/2)
#define isSmall(c) (SMALLMIN<=(c))
#define mkSmall(n) (SMALLZERO+(n))
#define smallOf(c) ((Int)(c-SMALLZERO))
#define mkInt(n) (isSmall(mkSmall(n)) ? mkSmall(n) : mkBig(n))
#define intOf(c) (isSmall(c) ? smallOf(c) : bigOf(c))
#define mkChar(c) ((Cell)(SMALLMIN+((unsigned)((c)%NUM_CHARS))))
#define charOf(c) ((char)((c)-SMALLMIN))
#define mkDict(n) ((Cell)(SMALLMIN+(n)))
#define dictOf(c) ((Int)((c)-SMALLMIN))
#define mkCfun(n) ((Cell)(SMALLMIN+(n)))
#define cfunOf(c) ((Int)((c)-SMALLMIN))
#define FAIL mkCfun(-1) /* Every type has a Fail */
/*- Control stack implementation ------------------------------------------*/
typedef Cell *StackPtr; /* stack pointer */
extern Cell cellStack[];
#ifdef GLOBALsp
register StackPtr sp GLOBALsp;
#else
extern StackPtr sp;
#endif
#define clearStack() sp=cellStack+NUM_STACK
#define stackLoop(i) for (i=cellStack+NUM_STACK-1; i>=sp; i--)
#define push(c) if (sp>cellStack) *--sp=(c); else overflow()
#define onto(c) *--sp=(c) /* fast form of push() */
#define pop() *sp++
#define drop() sp++
#define top() *sp
#define pushed(n) sp[n]
#define pushedSince(p) ((Int)((p)-sp))
#define offset(n) root[-(n)]
/*- references to body of compiled code -----------------------------------*/
#define ARGCHECK 0 /* set to 1 for no. of argument checking */
extern int argcheck; /* check for consistency between main */
/* program and runtime library */
extern int num_scs; /* supercombinators */
extern Cell sc[];
#if ARGCHECK
typedef Void Super Args((StackPtr));
#else
typedef Void Super Args((Void));
#endif
extern Super *scNames[];
extern int num_dicts; /* dictionaries */
extern Cell dict[];
extern int dictImps[];
#define dsel(n,d) dict[dictOf(d)+n]
/*-Super combinator skeleton definition -------------------------------------
* the following macros are used to construct the heading for a super-
* combinator definition. The combn() family of macros is used for the
* benefit of compilers which do not automatically unroll small loops.
* combinators with >9 args are headed using the comb macro, and a loop is
* always used ... at least in the C code. Adjust according to taste!
* ------------------------------------------------------------------------*/
#if ARGCHECK
#define defSc(nm,args) Void nm(root) \
register StackPtr root; { \
if (root-sp<=args) \
insufficientArgs(); \
root=sp;
#else
#define defSc(nm,args) Void nm() { \
register StackPtr root=sp;
#endif
#define Arg *root = snd(*(root+1)); root++;
#define needStack(n) if (sp-cellStack<n) overflow()
#define End }
#define comb(nm,n) defSc(nm,n) {int i=n; do {Arg} while (--i>0);}
#define comb0(nm) defSc(nm,0)
#define comb1(nm) defSc(nm,1) Arg
#define comb2(nm) defSc(nm,2) Arg Arg
#define comb3(nm) defSc(nm,3) Arg Arg Arg
#define comb4(nm) defSc(nm,4) Arg Arg Arg Arg
#define comb5(nm) defSc(nm,5) Arg Arg Arg Arg Arg
#define comb6(nm) comb(nm,6)
#define comb7(nm) comb(nm,7)
#define comb8(nm) comb(nm,8)
#define comb9(nm) comb(nm,9)
/*- macros for simple steps in compiled code -------------------------------*/
extern Cell whnf; /* head of term in weak head normal form */
extern Int whnfInt; /* integer value for term in whnf */
#define pushInt(n) onto(mkInt(n))
#define pushFloat(f) onto(safeMkFloat(f))
#define pushStr(s) onto(mkString(s))
#define mkap() sp[1]=pair(*sp,sp[1]); sp++
#define toparg(e) *sp=pair(*sp,e)
#define topfun(e) *sp=pair(e,*sp)
#define pushpair(l,r) onto(pair(l,r))
#define updap(o,l,r) snd(root[-o])=r; fst(root[-o])=l
#define update(o,c) updap(o,INDIRECT,c)
#define updap2(o) updap(o,*sp,sp[1]); sp+=2
#define alloc() pushpair(0,0)
#define slide(n,e) pushed(n)=e; sp+=n
#define setstk(n) sp=root-n
#define test(c) if (whnf!=c)
#define inteq(n) if (whnfInt!=n)
#define intge(h,n) if (whnfInt>=n) { \
heap(h); \
onto(mkInt(whnfInt-n)); \
} else
#define intdv(h,n) if (whnfInt>=0 && (whnfInt%n==0)) { \
heap(h); \
onto(mkInt(whnfInt/n)); \
} else
#define ret() sp=root; return
/* N.B. values in heap() calls are possibly overestimates of storage use
* if INTCELL or FLOATCELL (with BREAK_FLOATS) values are ever allocated.
* If you change the basic allocators used here so that the exact figure
* is required, it will probably be best to make sure that an INTCELL is
* _always_ heap allocated (including the two INTCELLs that make up a
* BREAK_FLOATS FLOATCELL). The alternative is to arrange that any unfilled
* cells are filled in with blanks of an appropriate form.
*/
#if GC_MARKSCAN
#define heap(n) /*do nothing*/
#endif
#if GC_TWOSPACE
#define heap(n) if (hp+(2*n)>=0) garbageCollect()
#endif
/*- builtin primitive functions -------------------------------------------*/
extern Cell primFatbar, primFail; /* System (internal) primitives */
extern Cell primUndefMem, primBlackHole;
extern Cell primSel, primIf;
extern Cell primStrict;
extern Cell primPlusInt, primMinusInt;/* User (general) primitives */
extern Cell primMulInt, primDivInt;
extern Cell primModInt, primRemInt;
extern Cell primNegInt, primQuotInt;
extern Cell primCharToInt, primIntToChar;
extern Cell primIntToFloat;
extern Cell primPlusFloat, primMinusFloat;
extern Cell primMulFloat, primDivFloat;
extern Cell primNegFloat;
extern Cell primEqInt, primLeInt;
extern Cell primEqChar, primLeChar;
extern Cell primEqFloat, primLeFloat;
extern Cell primGenericEq, primGenericNe;
extern Cell primGenericGt, primGenericGe;
extern Cell primGenericLt, primGenericLe;
extern Cell primShowsInt, primShowsFloat;
extern Cell primError;
extern Cell primFopen;
#if HAS_FLOATS
extern Cell primSinFloat, primAsinFloat;
extern Cell primCosFloat, primAcosFloat;
extern Cell primTanFloat, primAtanFloat;
extern Cell primAtan2Float, primExpFloat;
extern Cell primLogFloat, primLog10Float;
extern Cell primSqrtFloat, primFloatToInt;
#endif
/*- runtime support functions and variables -------------------------------*/
extern Void eval Args((Cell));
extern Void overflow Args((Void));
extern Void insufficientArgs Args((Void));
extern Void fail Args((Void));
extern Cell rootFst Args((Cell));
extern Int readTerminalChar Args((Void));
extern Void noechoTerminal Args((Void));
extern Void normalTerminal Args((Void));
/* ----------------------------------------------------------------------- */